home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 096 / pbbs.arc / PBBS.BAS next >
Encoding:
BASIC Source File  |  1987-04-07  |  11.6 KB  |  231 lines
  1. 0 'PBBS.BA BY DICK ROUX N1AED VERSION 2.0 08/21/86
  2. 10 CLEAR1000:MAXFILES=6:LC$="":MD=0:MM=0:UL=0:S=0:MW=0:MF=0:FL=0:MR=0:RQ=0:RD=0:C=0:L=0:MS=0:U=0:CR$="":B=0:M=0:CK=0:CK$="ON ":CALL16969
  3. 20 CA$="N1AED":NA$="Dick":T$="Merrimack NH":BE$="MAIL FOR: "
  4. 30 OPEN"ERRLOG.DO"FORAPPENDAS1:CLOSE1
  5. 40 GOSUB 2090
  6. 50 MM=0:MS=0:ONERRORGOTO80:OPEN"MESLOG.DO"FORINPUTAS4
  7. 60 LINEINPUT#4,I$:IFLEN(I$)=>3THENMS=MS+1:IFI$=CA$THENMM=MM+1
  8. 70 IFEOF(4)THENCLOSE4:GOTO90ELSE60
  9. 80 IFERR=52THENOPEN"MESLOG.DO"FORAPPENDAS4:PRINT#4,CR$:CLOSE4
  10. 90 ONCOMGOSUB280:ONERRORGOTO900
  11. 100 IFUTHENGOSUB2080:U=0:GOSUB190ELSEGOSUB190
  12. 110 COMON
  13. 120 E$=INKEY$:GOSUB130:GOTO150
  14. 130 DA$=RIGHT$(DATE$,2)+LEFT$(DATE$,2)+MID$(DATE$,4,2)
  15. 140 TI$=LEFT$(TIME$,2)+MID$(TIME$,4,2):RETURN
  16. 150 IFE$=""THEN120
  17. 160 ONINSTR("EPRSGKBMCT",E$)GOTO660,690,760,1650,840,1400,2075,3000,4000,5000
  18. 170 ONINSTR("eprsgkbmct",E$)GOTO660,690,760,1650,840,1400,2075,3000,4000,5000
  19. 180 GOTO120
  20. 190 IFCTHENRETURNELSECLS
  21. 200 PRINT"MAILBOX ACTIVE - WAITING ";MM;"/";MS;" Msgs"
  22. 210 PRINTFRE(0);" BYTES FREE   ";MR;"CONNECTS TODAY"
  23. 220 IFLEN(LC$)THENPRINT "Last User: ";LC$ELSEPRINT
  24. 225 IF B=0THENBB$="OFF"ELSEBB$="ON "
  25. 226 IF M=0THENMM$="OFF"ELSEMM$="ON "
  26. 230 '
  27. 235 PRINT"<P>rint Msgs <R>ead Msgs   <E>xit"
  28. 240 PRINT"<S>end Msg   <G>o Online   <K>ill Msgs"
  29. 250 PRINT"<B>eacon ";BB$;" <M>onitor ";MM$;" <T>ime"
  30. 260 PRINT"<C>onok ";CK$;"..SELECT.."
  31. 270 RETURN
  32. 280 IFEOF(2)THENCLOSE2:OPEN"COM:58N1E"FORINPUTAS2:IFS=0THEN360ELSEPRINT#4,Z$:Z$="":S=0:FL=1:FORI=1TO500:NEXT:COMON:GOSUB1530:GOSUB1560:GOTO360
  33. 290 C$=INPUT$(1,2):PRINTC$;:IFC$=CHR$(10)THENRETURN
  34. 300 IFC$=CHR$(13)THEN330
  35. 310 Z$=Z$+C$
  36. 320 IFLEN(Z$)=>78THEN330ELSERETURN
  37. 330 IFNOTCTHEN380
  38. 340 FG=INSTR(Z$,"*** conn"):IFFGTHENRQ$=MID$(Z$,20+FG,8):RQ=1:GOTO360
  39. 350 IFCTHEN430
  40. 360 IFRD=0ANDS=0ANDRQANDCTHENO$=RQ$+" Just Tried to Connect":GOSUB950:RQ=0
  41. 370 Z$="":RETURN
  42. 380 R=INSTR(Z$,"*** CON"):IFNOTLANDR>0THENCLS:C=-1:GOSUB2020:GOSUB2096ELSEGOTO360
  43. 390 IFFL=0THENGOSUB1030
  44. 400 COMSTOP
  45. 410 GOSUB1540
  46. 420 COMON:IFMFTHEN360ELSEGOSUB1280:GOSUB1560:GOTO360
  47. 430 IFINSTR(Z$,"*** DIS")THENC=0:GOSUB2100:GOTO640
  48. 440 IFINSTR(Z$,"retry")THEN370
  49. 450 IFSTHEN610
  50. 460 IFMFTHEN560
  51. 470 IFLTHEN360
  52. 480 IFZ$<>CR$THENZ=ASC(LEFT$(Z$,1)):IFZ>96ANDZ<123THENGOSUB2040:Z$=ZX$:ZX$=""
  53. 490 IFLEN(Z$)>1THEN560
  54. 500 IFZ$="T"THEN1190
  55. 510 IFZ$="R"THENGOSUB1320:GOSUB1560:GOTO360
  56. 520 IFZ$="H"THENGOSUB1760:GOSUB1560:GOTO360
  57. 530 IFZ$="I"THENGOSUB1810:GOSUB1560:GOTO360
  58. 540 IFZ$="B"THENGOSUB1590:GOSUB630:GOSUB2098:GOSUB2000:GOTO360
  59. 545 IFZ$="K"THENMD=1:O$="*** YOUR MESSAGE(S) WILL BE KILLED ***":GOSUB950:GOSUB1560:GOTO360
  60. 550 IFZ$<>CR$THENO$="*** NON FUNCTIONAL CMD ***":GOSUB950:GOSUB1560:GOTO360
  61. 560 IFLEFT$(Z$,1)="S"ANDMID$(Z$,2,1)=" "ANDINSTR(Z$,"<")=0THEN1430:COMSTOP
  62. 570 IFLEFT$(Z$,1)="S"ANDMID$(Z$,3,1)=" "THEN1440:COMSTOP
  63. 580 IFLEFT$(Z$,1)="S"ANDMID$(Z$,2,2)="  "THEN1440:COMSTOP
  64. 590 IFZ$<>CR$THENGOSUB2040:Z$=ZX$:ZX$="":IFZ$="R ALL"THENZA$="ALL":MW=1:GOSUB1330:MW=0:GOSUB1560:GOTO360
  65. 600 IFZ$<>CR$THENO$="*** WHAT?...Type <H>elp if you need it":GOSUB950:GOSUB1560
  66. 610 IFSTHENPRINT#4,Z$
  67. 620 GOTO360
  68. 630 O$=ZC$+" de "+CA$+": 73 ,CUL":GOSUB950:RETURN
  69. 640 COMSTOP:GOSUB2010:IFSTHENCLOSE4:S=0:GOSUB1850ELSEGOSUB1850:GOSUB2020:GOSUB1590:IFBTHENO$="BT "+BT$:GOSUB950
  70. 650 FL=0:L=0:MF=0:MR=MR+1:RD=0:GOSUB360:GOSUB1740:IFMDTHEN1410ELSEGOSUB2110:GOSUB1590:GOSUB670:GOTO100
  71. 660 COMOFF:CLOSE:GOSUB670:GOTO680
  72. 670 DATE$=LEFT$(DATE$,6)+"87":RETURN
  73. 680 MENU
  74. 690 COMSTOP:CLS
  75. 700 PRINT:INPUT"CHECK PRINTER - PRESS ENTER.. ";X$
  76. 705 CLS:INPUT"Print Your Mail";ZE$:IF ZE$="N"ORZE$="n"THENINPUT"Print Whose";ZC$ELSEZC$=CA$
  77. 710 OPENZC$+".DO"FORINPUTAS3:OPEN"LPT:"FOROUTPUTAS4
  78. 720 LINEINPUT#3,C$
  79. 730 IFEOF(3)THENPRINTC$:PRINT#4,C$:CLOSE3,4:GOTO100
  80. 740 FORI=1TO250:NEXT:PRINTC$:PRINT#4,C$
  81. 750 GOTO720
  82. 760 COMSTOP:CLS:ONERRORGOTO830
  83. 770 MS=0:INPUT"Read Your Mail";ZE$:IF ZE$="N"ORZE$="n"THENINPUT"Read Whose";ZC$ELSEZC$=CA$
  84. 780 OPENZC$+".DO"FORINPUTAS3
  85. 790 LINEINPUT#3,C$
  86. 800 IFEOF(3)THENPRINTC$:CLOSE3:PRINTCR$:PRINT"*** END OF MESSAGES ":FORI=1TO1000:NEXT:GOTO50
  87. 810 FORI=1TO500:NEXT:PRINTC$
  88. 820 GOTO790
  89. 830 IFERR=52THENPRINT"*** NO MESSAGES":GOSUB1590:RESUME50
  90. 840 CLS:L=-1:PRINT"*** ONLINE *** ":PRINT"^D To cmd:":PRINT"<ESC> to Return"
  91. 850 E$=INKEY$:IFE$=""THEN850
  92. 860 IFE$=CHR$(27)THENL=0:Z$="":IFCTHENGOSUB1560:GOTO100ELSEGOTO100
  93. 870 IFE$=CHR$(8)THENPRINTCHR$(8);CHR$(32);
  94. 880 PRINT#1,E$;:IFE$=CHR$(13)THENPRINTE$ELSEPRINTE$;
  95. 890 GOTO850
  96. 900 CLOSE:BEEP:OPEN"ERRLOG.DO"FORAPPENDAS6
  97. 910 PRINT#6,"ERROR ";ERR;" IN LINE ";ERL;" WHILE ";ZC$;" WAS ON AT ";TI$;" ON ";DA$
  98. 920 IFCANDERR=57THENCLOSE6:S=0:Z$="":O$="*** SORRY, CAN'T DO IT, RAN OUT OF FILE SPACE !!! ***":GOSUB2090:GOSUB950:MF=0:RESUME1560
  99. 930 IFCANDERR=7THENCLOSE6:CLOSE4:S=0:Z$="":O$="*** SORRY, CAN'T DO IT, RAN OUT OF MEMORY !!! ***":GOSUB2090:GOSUB950:MF=0:RESUME1560
  100. 940 IFCANDERR=52THENCLOSE6:RD=0:MW=0:Z$="":O$="*** NONE FOUND":GOSUB2090:GOSUB950:RESUME360ELSECLOSE6:Z$="":RESUME40
  101. 950 FORX=1TOLEN(O$)
  102. 960 S$=MID$(O$,X,1)
  103. 970 FORI=1TO3:NEXT
  104. 980 PRINT#1,S$;
  105. 990 PRINTS$;
  106. 1000 NEXT
  107. 1010 PRINT#1,CHR$(13);:PRINT
  108. 1020 RETURN
  109. 1030 IFMID$(Z$,21+R,1)="-"THENZC$=MID$(Z$,17+R,4):GOTO1080
  110. 1040 IFMID$(Z$,21+R,1)=" "THENZC$=MID$(Z$,17+R,4):GOTO1080
  111. 1050 IFMID$(Z$,22+R,1)="-"THENZC$=MID$(Z$,17+R,5):GOTO1080
  112. 1060 IFMID$(Z$,22+R,1)=" "THENZC$=MID$(Z$,17+R,5):GOTO1080
  113. 1070 ZC$=MID$(Z$,17+R,6)
  114. 1080 RESTORE
  115. 1090 READZF$,N$,MF
  116. 1100 IFINSTR(ZF$,ZC$)THENRETURN
  117. 1110 IFZF$="END"THENN$=ZC$:RETURN
  118. 1120 GOTO1090
  119. 1130 DATA"KA4KYI","Ron",0,"WN4ISX","Terry",0,"KJ4FZ","Mike",0
  120. 1140 rem DATA"K1OIQ","Al",0,"WA1HUM","Dana",0,"KA1MCD","Chris",0
  121. 1150 rem DATA"WA1OMM","Paul",0,"N1AHH","Ron",0,"W1TF","Ty",0
  122. 1160 rem DATA"WB1DSW","Herb",1,"KE1G","Bill",1,"W4PAS","Dick",0
  123. 1170 rem DATA"KG6LC","Paul",0,"W0RLI","Hank",1,"K1MRK","Carl",0
  124. 1180 DATA"END","END",0
  125. 1190 PG=VAL(LEFT$(TIME$,2)):IFPG>5ANDPG<14THENO$="Sorry...Paging is disabled untill after 9 A.M. >":GOSUB950:GOSUB1570:GOTO360
  126. 1200 CLS:O$="Paging "+NA$+"...(for about 30 Sec.) >":GOSUB950
  127. 1210 PRINT:PRINTZC$;" Wants to Chat..."
  128. 1220 PRINT:PRINT"hit <G> to go online"
  129. 1230 FORI=1TO175
  130. 1240 FORP=1TO10:NEXT:BEEP
  131. 1250 E$=INKEY$:IFE$="G"ORE$="g"THENO$=NA$+" is at the keyboard...Standby! >":GOSUB950:COMON:GOTO840
  132. 1260 NEXT:O$="Guess "+NA$+" is not around...Sorry":GOSUB950
  133. 1270 O$="Feel free to leave "+NA$+" a message...73 & TNX >":GOSUB950:GOSUB1570:GOTO360
  134. 1280 ONERRORGOTO1300:O$="*** CHECKING MAIL...":GOSUB950:OPENZC$+".DO"FORINPUTAS5
  135. 1290 O$="*** YOU HAVE MAIL *** HIT 'R' TO READ":ONERRORGOTO900:GOSUB950:MW=1:CLOSE5:RETURN
  136. 1300 IFERR=52THENO$="*** SORRY..NO MAIL":RESUME1310
  137. 1310 GOSUB950:ONERRORGOTO900:RETURN
  138. 1320 ZA$=ZC$
  139. 1330 IFMW=0THENO$="*** SORRY...NO MAIL":GOSUB950:RETURNELSERD=1:OPENZA$+".DO"FORINPUTAS5
  140. 1340 LINEINPUT#5,ZD$
  141. 1350 O$=CR$:GOSUB950:LINEINPUT#5,O$:DB$=LEFT$(O$,6):TB$=RIGHT$(O$,4)
  142. 1360 GOSUB1600
  143. 1370 LINEINPUT#5,O$:IFINSTR(O$,"<")THENZD$=O$:GOTO1350ELSEGOSUB950
  144. 1380 IFEOF(5)THENCLOSE5:IFZA$<>"ALL"THENO$="*** PLEASE KILL YOUR MAIL WITH THE 'K' CMD BEFORE YOU DISCONNECT ***":GOSUB950:RD=0:RETURNELSERD=0:RETURN
  145. 1390 GOTO1370
  146. 1400 CLS:INPUT"Kill Your Mail";ZE$:IFZE$="N"ORZE$="n"THENINPUT"Kill Whose";ZD$:GOSUB2030:ZC$=ZX$:ZX$="":U=1ELSEZC$=CA$:U=1
  147. 1410 MD=0:KILLZC$+".DO":GOSUB1920:GOSUB2090:GOSUB2110:GOSUB670:GOTO50
  148. 1420 ZD$=MID$(Z$,4,6):Z$=Z$+" < "+ZC$:GOTO1470
  149. 1430 ZD$=MID$(Z$,3,6):Z$=Z$+" < "+ZC$:GOTO1470
  150. 1440 IFINSTR(Z$,"<")=0THEN1420
  151. 1450 IFINSTR(Z$,"@")=0THEN1460ELSEZD$=MID$(Z$,4,INSTR(Z$,"@")-5):GOTO1470
  152. 1460 ZD$=MID$(Z$,4,INSTR(Z$,"<")-5)
  153. 1470 S=1:OPENZD$+".DO"FORAPPENDAS4
  154. 1480 PRINT#4,Z$
  155. 1490 PRINT#4,DA$;" ";TI$
  156. 1500 IFMFTHENZ$="":COMON:GOTO90
  157. 1510 COMON:O$="Enter Message, Cntl-z to end:":GOSUB950
  158. 1520 Z$="":GOTO100
  159. 1530 CLOSE4:OPEN"MESLOG.DO"FORAPPENDAS4:GOSUB2030:ZD$=ZX$:ZX$="":PRINT#4,ZD$:CLOSE4:MS=MS+1:GOSUB2120:IFMF=1THENRETURNELSEO$="*** DONE":GOSUB950:RETURN
  160. 1540 IFMFTHEN1560ELSEO$="Hello "+N$+", Welcome to the "+CA$+" MINI-PBBS in "+T$:GOSUB950
  161. 1550 O$="H for HELP, I For System Info; There are"+STR$(MS)+" Msgs On the System":GOSUB950:RETURN
  162. 1560 IFFRE(0)<1000 THENO$=" *** CAUTION - THE MEMORY IS FULL..PLEASE DO NOT ATTEMPT TO LEAVE ANY MESSAGES ***":GOSUB950
  163. 1570 GOSUB130:O$=ZC$+" de "+CA$+" at "+TI$+"z on "+DA$+"  B,H,I,K,R,S,T, >":GOSUB950:IFMFTHEN1580ELSERETURN
  164. 1580 O$="*":GOSUB950:O$="*":GOSUB950:RETURN
  165. 1590 FORI=1TO500:NEXT:RETURN
  166. 1600 IFINSTR(ZD$,"@")=0THEN1630
  167. 1610 O$=" TR  "+" TO  "+" @ BBS  "+"  From"+"    Date  "+"   Time":GOSUB950
  168. 1620 O$=" "+ZD$+"   "+DB$+"   "+TB$:GOSUB950:RETURN
  169. 1630 O$=" TR  "+" TO  "+"  From"+"     Date  "+"   Time":GOSUB950
  170. 1640 O$=" "+ZD$+"   "+DB$+"   "+TB$:GOSUB950:RETURN
  171. 1650 CLS:LINEINPUT"Call sign of Receiver ";ZD$:GOSUB2030:ZD$=ZX$:ZX$=""
  172. 1660 OPENZD$+".DO"FORAPPENDAS4
  173. 1670 PRINT#4,"S  "+ZD$+" < "+CA$
  174. 1680 PRINT#4,DA$;" ";TI$
  175. 1690 PRINT"Input Message.../EX to End (ON A BLANK LINE)"
  176. 1700 LINEINPUTI$
  177. 1710 IFINSTR(I$,"/EX")>0ORINSTR(I$,"/ex")>0THEN1730
  178. 1720 PRINT#4,I$:GOTO1700
  179. 1730 PRINT#4,CR$:CLOSE4:OPEN"MESLOG.DO"FORAPPENDAS4:GOSUB2030:ZD$=ZX$:ZX$="":PRINT#4,ZD$:CLOSE4:PRINT"*** DONE":FORI=1TO500:NEXT:MS=MS+1:GOSUB2120:U=1:GOSUB2080:U=0:GOTO100
  180. 1740 OPEN"USELOG.DO"FORAPPENDAS4
  181. 1750 LC$=ZC$+" AT "+TI$+" ON "+DA$:PRINT#4,LC$:CLOSE4:RETURN
  182. 1760 RD=1:O$="The command Syntax is:":GOSUB950
  183. 1770 O$="B<CR> - Bye (DISC)           K<CR> - Kill Your Mail":GOSUB950
  184. 1780 O$="H<CR> - This HELP File       I<CR> - System Information":GOSUB950
  185. 1790 O$="R<CR> - Read YOUR mail       R ALL<CR> - Read mail addressed to 'ALL'":GOSUB950
  186. 1800 O$="S 'CALL' - Send mail         T<CR> - Pages "+NA$+" for 30 sec":GOSUB950:RD=0:RETURN
  187. 1810 RD=1:O$="This MINI-PBBS is run on a 32K TRS80 Model 100...It lacks the complete":GOSUB950
  188. 1820 O$="repertoire of a full PBBS; It was written to work within the memory":GOSUB950
  189. 1830 O$="restraints of the Model 100.  It's main purpose is to be able to":GOSUB950
  190. 1840 O$="store and retrieve messages....73  "+NA$+" "+CA$:GOSUB950:RD=0:RETURN
  191. 1850 COMSTOP:OPEN"MESLOG.DO"FORINPUTAS4
  192. 1860 LINEINPUT#4,O$:GOSUB1890
  193. 1870 IFEOF(4)THENCLOSE4:GOTO1910
  194. 1880 GOTO1860
  195. 1890 IFINSTR(O$,ZC$)THENRETURN
  196. 1900 IFINSTR(BE$,O$)THENRETURNELSEBE$=BE$+O$+" ":RETURN
  197. 1910 O$=BE$:BT$=BE$:COMON:IFLEN(BE$)=<10THENRETURNELSEGOSUB950:BE$="MAIL FOR: ":RETURN
  198. 1920 MM=0:MS=0:OPEN"MESLOG.DO"FORINPUTAS4
  199. 1930 OPEN"MESLO.DO"FOROUTPUTAS5
  200. 1940 PRINT#5,CR$
  201. 1950 LINEINPUT#4,I$:IFEOF(4)ANDI$=ZC$THENGOTO1980
  202. 1960 IFI$=ZC$THENI$="":GOTO1950
  203. 1970 IFI$=CR$THEN1980ELSEPRINT#5,I$:MS=MS+1:IFZD$=CA$THENMM=MM+1
  204. 1980 IFEOF(4)THENCLOSE4,5:KILL"MESLOG.DO":NAME"MESLO.DO"AS"MESLOG.DO":RETURN
  205. 1990 GOTO1950
  206. 2000 GOSUB1590:O$="D":GOSUB950:RETURN
  207. 2010 GOSUB1590:O$="CONV":GOSUB950:RETURN
  208. 2020 GOSUB1590:O$=CHR$(4):GOSUB950:RETURN
  209. 2030 Z$=ZD$
  210. 2040 FORX=1TOLEN(Z$)
  211. 2050 S$=MID$(Z$,X,1)
  212. 2060 IFASC(S$)>96ANDASC(S$)<123THENS$=CHR$(ASC(S$)-32)
  213. 2070 ZX$=ZX$+S$:NEXT:RETURN
  214. 2075 IF B=0 THEN 2080 ELSE 2095
  215. 2080 ZC$="XXX":BE$="BT MAIL FOR: ":CLS:GOSUB1850:GOSUB1590:IFUTHENZC$="":RETURNELSEO$="BE EV 90":B=1:GOSUB950:ZC$="":GOSUB1590:GOTO100
  216. 2090 OPEN"COM:58N1E"FOROUTPUTAS1:OPEN"COM:58N1E"FORINPUTAS2:RETURN
  217. 2095 GOSUB1590: O$="BE 0":GOSUB950:GOSUB1590:B=0:GOTO100
  218. 2096 GOSUB1590:O$="TRANS":GOSUB950:RETURN
  219. 2098 GOSUB1590:GOSUB1590:FORI=1TO3:PRINT#1,CHR$(4);:NEXT:GOSUB1590:GOSUB1590:RETURN
  220. 2100 GOSUB1590:O$="CONOK OFF":GOSUB950:RETURN
  221. 2110 GOSUB1590:O$="CONOK ON":GOSUB950:RETURN
  222. 2120 IFZD$=CA$THENMM=MM+1:RETURNELSERETURN
  223. 3000 IFM=0THEN3010ELSE3020
  224. 3010 O$="MON ON":GOSUB950:M=1:GOSUB1590:GOTO100
  225. 3020 O$="MON OFF":GOSUB950:M=0:GOSUB1590:GOTO100
  226. 4000 IFCK=0THENGOSUB2100:GOSUB1590:CK=1:CK$="OFF":GOTO100
  227. 4010 IFCK<>0THENGOSUB2110:GOSUB1590:CK=0:CK$="ON ":GOTO100
  228. 5000 O$="DAY "+DA$+TI$+RIGHT$(TIME$,2):GOSUB950:GOSUB1590:GOTO100
  229. 4010 IFCK<>0THENGOSUB2110:GOSUB1590:CK=0:CK$="ON ":GOTO100
  230. 5000 O$="DAY "+DA$+TI$+RIGHT$(TIME$,2):GOSUB950:G
  231.